Traffic Count Analysis to Inform Model Validation

Permanent Traffic Count Stations in TRPA Region (2018)

map<-continuous %>% distinct(lat,lon, station)
  map %>%
  st_as_sf(coords=c("lon", "lat"), crs=4326) %>% 
  leaflet() %>% addTiles() %>% addMarkers(popup = paste(map$station))

Raw Daily Totals

ggplotly(
  continuous %>% group_by(Day, station) %>% 
    summarise(Count=sum(Count)) %>% ggplot(aes(Day, Count, group=station, fill=station)) + 
    geom_col()+theme_minimal() + theme(axis.title.x=element_blank(), legend.position = "none", axis.title.y=element_blank()) + scale_x_date() 
  )

Hourly Count Distribution

ggplotly(
ggplot(data = continuous, aes(x = Count)) + 
   geom_histogram(aes(y=..density..),colour="black", fill="white") +
  geom_density(alpha=.2, fill="#FF6666")+ theme_minimal() + 
   theme(axis.title.x = element_blank(), axis.text.y=element_blank(), axis.title.y=element_blank()) 
)

Daily Count Distribution

ggplotly(
continuous %>% 
  group_by(Day) %>% 
  summarise(Count=sum(Count, na.rm=T)) %>% 
  ggplot(aes(Count)) +
  geom_histogram(aes(y=..density..),colour="black", fill="white") +
  geom_density(alpha=.2, fill="#FF6666")  +
  theme_minimal() +
  theme(axis.title.x = element_blank(), axis.text.y=element_blank(), axis.title.y=element_blank())
)

Daily Count Totals Count by Day of Week

all_days<- continuous %>% 
  group_by(weekday, Day) %>% 
  summarise(Count=sum(Count, na.rm=T)) %>% 
  ungroup()

ggplotly(
  ggplot(all_days, aes(Day,Count, group=weekday, color=weekday)) + geom_line() + theme_minimal() + theme(axis.title.y = element_blank())) %>%
  layout(legend = list(orientation = "h", x = 0.0, y = -0.3)) 

Summary Statistics all Data

options(scipen=999)

ggplotly(
continuous %>%
  group_by(Day,month, weekday) %>%
  summarise(Count=sum(Count,na.rm=T)) %>%
ggplot(aes(x = weekday, y = Count, color = weekday)) +
  theme(axis.text.x=element_blank(), axis.title.x=element_blank(), axis.title.y=element_blank(), axis.ticks.x=element_blank()) +
  geom_boxplot(outlier.shape = NA) +
  facet_grid(~month) + theme(legend.position="bottom") +
  scale_color_manual(values=c("#08D6DA", "#06378D", "#BE0B05", "#F7A537", "#DEF006", "#35AA27", "#940CD8")), height=800) %>%
  layout(legend = list(orientation = "h", x = 0.0, y = -0.2)) %>%
  style(legendgroup = NULL)

Median Daily Total Counts by Day of Week

ggplotly(
continuous %>% 
  group_by(weekday, month,Day) %>% 
  summarise(Count=sum(Count, na.rm=T)) %>% 
  group_by(weekday, month) %>% 
  summarise(median_count=median(Count)) %>%
  ungroup() %>%
  ggplot(aes(month,median_count, group=weekday, color=weekday)) + geom_line(size=1) + theme_minimal() + 
  theme(legend.position="bottom", legend.title = element_blank(), axis.title.x=element_blank(), axis.title.y=element_blank()) +
  scale_colour_manual(values=c("#08D6DA", "#06378D", "#BE0B05", "#F7A537", "#DEF006", "#35AA27", "#940CD8"))
)

Daily Count Distribution by Month of Year

options(scipen=999)

continuous %>%
  group_by(Day, month) %>%
  summarise(Count=sum(Count,na.rm=T)) %>%
  ggplot(aes(x = Count, y = factor(month), fill=month)) +
  ggridges::geom_density_ridges(stat = "density", aes(height = stat(density))) +
  theme_minimal() + scale_fill_discrete() + 
  theme(axis.title.y = element_blank(), legend.position="none", axis.text.y=element_text(size=14), axis.text.x=element_text(size=14), axis.title.x=element_blank())

ggplotly(
continuous %>% 
  group_by(Day, month) %>%
  summarise(Count=sum(Count,na.rm=T)) %>%
  ggplot(aes(month, Count)) + geom_violin() + theme_minimal() + theme(axis.title.y=element_blank(), axis.title.x=element_blank()) +
  scale_y_continuous(labels=scales::comma)
)

Median Daily Count by Month of Year

ggplotly(
continuous %>% 
  group_by(Day, month, station) %>%
  summarise(Count=sum(Count,na.rm=T)) %>%
  group_by(month, station) %>%
  summarise(Count=median(Count)) %>% 
  ggplot(aes(month, Count, group=station, fill=station)) + geom_col() + theme_minimal() +
   theme(legend.title = element_blank(), axis.title.x=element_blank(),axis.title.y=element_blank(), axis.text.y=element_blank(),
        axis.text.x=element_text(size=12), legend.position = "none") 
)

Daily Count Distribution by Day of Week

options(scipen=999)
continuous %>%
  group_by(Day, weekday) %>%
  summarise(Count=sum(Count,na.rm=T)) %>%
  ggplot(aes(x = Count, y = factor(weekday), fill=weekday)) +
  ggridges::geom_density_ridges(stat = "density", aes(height = stat(density))) +
  theme_minimal() + scale_fill_discrete() + 
  theme(axis.title.y = element_blank(), legend.position="none", axis.text.y=element_text(size=14), axis.text.x=element_text(size=14), axis.title.x=element_blank())

ggplotly(
continuous %>% 
  group_by(Day, weekday) %>%
  summarise(Count=sum(Count,na.rm=T)) %>%
  ggplot(aes(weekday, Count)) + geom_violin() + theme_minimal() + theme(axis.title.y=element_blank(), axis.title.x=element_blank()) +
  scale_y_continuous(labels=scales::comma)
)

## Median Daily Count by Day of Week

ggplotly(
continuous %>% 
  group_by(Day, weekday,station) %>%
  summarise(Count=sum(Count,na.rm=T)) %>%
  group_by(weekday, station) %>%
  summarise(Count=median(Count)) %>% 
  ggplot(aes(weekday, Count, group=station, fill=station)) + geom_col() + theme_minimal() +
   theme(legend.title = element_blank(), axis.title.y=element_blank(),axis.title.x=element_blank(), axis.text.y=element_blank(),
        axis.text.x=element_text(size=12), legend.position = "none")
)

Station Type Counts - Weekend vs Weekday

ggplotly(
continuous %>% 
  group_by(wday_wknd, ext_int,Day) %>% 
  summarise(Count=sum(Count, na.rm=T)) %>%
  ggplot(aes(Day,Count)) + geom_line(size=1) +
  facet_grid(wday_wknd ~ ext_int ) +
  theme(legend.position="bottom", legend.title = element_blank(), axis.title.x=element_blank(), axis.title.y=element_blank(),
        axis.text.x=element_text(angle=34, hjust=1)) +
  scale_y_continuous(labels=scales::comma)
)

Counts for Entry/Exit Stations only by Day of Week

ggplotly(
continuous %>% 
  filter(ext_int=="External Station") %>%
  group_by(Day, weekday, station) %>%
  summarise(Count=sum(Count,na.rm=T)) %>% 
  group_by(weekday, station) %>%
  summarise(Count=median(Count)) %>% 
  ggplot(aes(weekday, Count, group=station, fill=station)) + geom_col() + theme_minimal() +
  theme(legend.title = element_blank(), legend.position = 'none', axis.title.x=element_blank(),axis.title.y=element_blank(), axis.text.x=element_blank(),
        axis.text.y=element_text(size=12)) + coord_flip()
)

Counts Entry/Exit Stations only by Month

ggplotly(
continuous %>% 
  filter(ext_int=="External Station") %>%
  group_by(Day, month, station) %>%
  summarise(Count=sum(Count,na.rm=T)) %>%
  group_by(month, station) %>%
  summarise(Count=median(Count)) %>%
  ggplot(aes(month, Count, group=station, fill=station)) + geom_col() + theme_minimal()  +
 theme(legend.title = element_blank(), legend.position = 'none', axis.title.x=element_blank(),axis.title.y=element_blank(), axis.text.x=element_blank(),
        axis.text.y=element_text(size=12))  + coord_flip()
)

All Daily Counts by Station and Time Period

ggplotly(
continuous %>%
  group_by(Day, weekday, month, station, ext_int) %>%
  summarise(Count=sum(Count)) %>%
  mutate(dummy="") %>%
ggplot(aes(dummy,station,  fill = Count)) + 
  geom_tile(colour = "white") + 
  facet_grid(weekday~month) + 
  scale_fill_gradient(low="red", high="green") +
  theme(axis.ticks.x=element_blank(), axis.title.x=element_blank(), axis.title.y=element_blank(), axis.text.y=element_text(size=7), axis.text.x=element_blank()), height = 950)